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LL PPPPPPPP AAAAAA =«‘TTTITITTIT EEEEEEEEEE © SSSSSSSS TTTTTITITT 
LL PPPPPPPP AAAAAA  —‘TTTTITTTTT EEEEEEEEEE — SSSSSSSS TTTTTTTTTT 

LL PP PP AA AA TT EE $$ TT 

LL pp PP AA AA TT EE SS TT 

LL pp PP AA AA TT EE S$ TT 

LL PP PP AA AA TT EE $$ TT 

LL PPPPPPPP = AA AA 1T EEEEEEEE SSSSSS 1T 

LL PPPPPPPP = AA AA 1T EEEEEEEE SSSSSS TT 

Lt PP AAAAAAAAAA 1T FE $$ TT 

LL PP AAAAAAAAAA TT EE SS 1T 

LL pp AA AA 1T EE SS TT nee 
LL PP AA AA 1T EE $$ TT in 
LLLLLLLLLL PP AA AA TT EEEEEEEEEE SSSSSSSS TT ee 
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FFFFFFFFFF 000000 RRRRRRRR 
FFFFFFRFFF 000000 RRRRRRRR 
FF 0O RR RR 
FF 00 OO RR RR 
FF 00 OO RR RR 
FF RR RR 
FF FF 00 00 RRRRRRRR 
FF FF 00 00 RRRRRRRR 
FF 00 00 RR RR 

FF 00 00 RR RR 

FF OO RR RR 
FF RR RR 
FF 000000 RR RR 
FF 000 R RR 
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c 
c Define terminal input and output channels 
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Version ‘V04-000' 


PRRRRBRASAALA REAL AAAALALALALAALALAL ALLA ES ALES EE ERASE AEA REESE SESE ES ARES 


COPYRIGHT (c) 1978, 1980, 1982, 1984 BY 
DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. 
ALL RIGHTS RESERVED. 


THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COP 
ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH 
INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OT 
COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO A 
vanisreRReD NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HERE 


THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE W 
ebpokat ihe NOT BE CONSTRUED AS A COMMITMENT BY DIGI 


DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 
SOFTWARE ON FQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. 


ITHOUT NOTICE 
TAL EQUIPMENT 


Example program ior LPA11-K Lab Peripheral Controller 
LPA1T171=K TEST PROGRAM 


This Pe oe prompts FORSINPUT for the set of LPA11-K sample parameters 
s 


and starts an LPAl1-K sweep using those parameters. 


11-Aug-1979 


integert2 buf fer(20000) ,rcl(100),iosb(4) ,device,l 
integer*4 ibuf(50),istat,bufnum,rate,preset dwe(l,sampls 
integer*t4 strtch,chninc,bffrs,mode,de ay buisiz,share 
integer*4 inoyt -Gutput number comput .£e siz 

dimension fr(7) 

common /ladata/buffer 

equivalence (ioso(1),ibuf(1)) 


Set some intitial default values for sampling paramaters 
Array FR is used to index clock crystal rate for KW11-K 


fr(1)=1000000. 
er tgrei panne. 
fr(3)=10000. 
fr(4)=1000. 
fr(5)=100. 
fr(7)=60. 


AARASAAASLASALALALALALAALAAE ARRAS SALAS ASAE ALAS A SASS | 
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C 
input=5 
output=6 


4 
c These are default initial values for interactive paramaters 
C 


nmode=-1234 ! microcode mode - load new microcode first time 
rate= ' clock counter rate - 1MH 

preset=-200 ' clock counter preset - ; 0 ticks 

dwell=1 ! dwell = delay time within each sample sequence 
samp|s=1 ' number of samples in a sample sequence 
strtch=0 ' start channel number 

chninc=1 ' channel increment - if zero then random channel List 
bufsiz=1000 ' size of each data buffer 

number=2 ' number of data buffers to use 

bf frs=100 ' total number of buffers to fill 

mode=64 ' sample mode 

delay=10 ! delay before first sample 

device=2hAD ' sample device type - A 

comput= ' compute load for each buffer 

rclsiz=100 ! size of random channel List 


crenee and input SHARE flag 

If share flag is non-zero, the micro-code will not be loaded 

This allows additional copies of this program to be run when the 
LPA11-K is in Multi-Request Mode. I.£., the first copy of this 
program would be run with the SHARE flag set to 0, causing the clock 
rate to be set, the second and Later copies of the program would be 
run with the SHARE flag non-zero, using the previous clock rate set. 


write(output,2121) 
format(' Share poe $) 
read(input,1002,en =500,err=500)n,share 


Prompt for and read in sample paramaters interactively 


HOaoaaaaaanannan 


~ 
— 
~ 
— 


CLOCK CRYSTAL RATE 


0 write(output 1000) rate 

000 ~=format(//* clock rate (",i1,'):',$) 
read(input,1002,err=500,end=500)n,k 

1002 format (q, i6) 

if (n .gt. and. k .lt. O)goto 24 

if (m .gt. 0 .and. k .ge. 0 .and. k .le. 7)rate=k 


c 
c CLOCK COUNTER PRESET 
c 


write(output,1004)preset 

1004 format(* clock preset: (°,i16,'):",$) 
read(input 1002,err=500,end=500)n.k 
if(n .gt. 6 .and. k .lt. O)preset=k 


=A Aaaan 


if (rate .eq. 6 .or. rate .eq. 0)goto 12 
freq=fr(rate)/-preset 


1013 


F 14 
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write(output, 3000) freq 
format (' clock frquency is ',f12.3,' hertz') 


COMPUTE LOAD PER BUFFER 


write(output, 1005) comput 

format(' compu ute load (',i16,'):',$) 

reedt input, aes err= $00 .endzsoon® k 
(n .gt. 0 .and. k .ge. 0)comput=k 


DWELL 


write(output 1099 dye} t 

format(' dwell (°',16,'):',$) 
read(input,1002, efr=S00, hd =500)n,k 
if(n .gt. 6) dwell = 


NUMBER OF SAMPLES per SAMPLE SEQUENCE 
write(output, 1008) sampls 
format(' number of $508. er (' ',$) 
reedt input 1002, —_ 500,end= SSbOsn.k 
n .gt. 6) samp|s=k 
START CHANNEL 
write(output, 1010)strtch 
format(' start channel (',i13,'):',$) 
read(input,1002,err= 500,end= =b00in‘R 
if(m .gt. 6 .and. k .ge. 0 .and. ‘a wle. 128)strtch=k 
CHANNEL INCREMENT 


write(output,1012)chninc 


format(' channel increment (' »'):',$) 
Coedt Inout 1002 erresee Aner {S603 n,k 
if(n 6) chninc=k 


iftchayne «ne. 0)goto 20 
RANDOM CHANNEL LIST SIZE 


write(output, [orserete's., 

format(' rcl Length or" 

reed( Inout 1002, end= Sob etre 506 )n ok : 

if (n “9 6 one k .gt. 0 .and. ( ele. 100)rclsiz=k 
ait) 5 l,rclsiz 


cont nue 
rclCikd=rcl (ik) +*8000'x 

NUMBER OF BUFFER AREAS 
write(output, 1013) number 


format(' number of buffer areas c* 90") a* 8) 
read(input,1002,err=500,end=500)n,k 


ad 
> 


@See#teeeeteteweteweweeweweweeeeene eee 
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NAAN Aaaan 
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if(m .gt. 0 .and. k .ge. 2 .and. k .le. 8)number=k 
C SIZE OF EACH BUFFER 


write(output,1015)bufsiz 
1015 ~—s format(" buffer size (',i5,"):',$) 
read(input 1002 err=500.end=5005n,k 
if(n .gt. 6 wand. k ge. 10 .and. k*number .le. 20000)bufsiz=k 


c TOTAL BUFFERS TO FILL 


write(output,1014)bffrs 

1014 format(' total buffers to fill (",i16,°):',$) 
read(input,1002,err=500,end=500)n,k 
if (mn .gt. O)bffrs=k 


c DELAY BEFORE SAMPLE START 


write(output,1016)dela 

1016 format (' oot ox (*,16,°):",$) 
read(input,10 2,err=500,end=500)n,k 
if (mn .gt. O)delay=k 


SAMPLE MODE 
Some typical values for the sample mode are: 


c 
c 

Cc 

c 

c 

c 0 = Dedicated Mode 

c 64 = Multi-request Mode 

c 512 = External Trigger 

c 8192 = Dual A/D converters - Serial 

c 8224 = Dual A/D converters - Parallel 
c 


write(output,1018)mode 

1018 format(' sample mode (',i16,'):',$) 
read(input,1 02,err=500,end=500)n,k 
if(n .gt. 6)mode=k 


c DEVICE TYPE 


write(output,1020)device 
1020 format(' device type (*,1a2,'):",$) 
read(input,1022)n, 
1022 toraatie. tae? 
if(m .le. 99 to 24 
if(l .eq. 2hAD .or. L .eq. 2hDA .or. | .eq. 2hnDI wor. Ll .eq. 
1 2hD0)device=l 


Determine microcode mode from sample mode and device type 
Load new microcode if microcode mode has changed 


4 1s<shere -ne. O)goto 16 
e= 
if (iand(mode,64) .eq. 0) imode=2 


if(device .eq. 2hDA .and. imode .eq. 2) imode=3 
if(imode .eq. nmode)go to 16 


can 


- i: 


a Co 


MOOAONMROAoOoaA- Aan oon 
oo 


ss 


nan 
wa 
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call Lpa$loadmc (imode,0,istat) 
f(.not. istat)go to $16 
nmode=imode 


C 
¢ 
c 
c Start lpall real time clock at specified rate and preset : 
c 
16 call puny Lecepsrane gr geet. tetet? c 
‘ if(.not. istat)go to 520 C 
fi C 
c 50 
call ibfint(ibut, {stat ,buf fer butsiz,number) Ly 
if(.not. istat)go to 5$ c 
C 
¢ 
C 
c Release all the buffers 60 
c 


do 40 i11=0,number-1 
call lpa$r(sbuf(ibuf, istat,i1) 
(.not. istat)go to 540 
0 continue 


Initialize ibuf array for sweep 
Set channel information for sweeps 


aoaana 


if(chnine .ne. O)call lpa$setadc(ibuf.,strtch,sampls,chninc) 
if(chninc .eq. O)call lpa$Ssetadc(ibuf,,rcl,sampls,0) 
Start the sweeps - conditional on what device requested 


if(device .eq. 2hAD)call lpaSadswo(ibuf,bufsiz,bffrs, 
1 mode, dwell,,delay,,,istat) 


if(device .eq. 2hDA)call lpaSdaswpo(ibuf,bufsiz.bffrs, 
1 mode,dwell,,delay,,,istat) 


if device .eq. 2hD])call lpa$diswpo(ibuf,bufsiz.bffrs, 
1 mode, dwell,,delay,,,istat) 


if(device .eq. 2hD0)call lpa$doswp(ibuf,bufsiz,bffrs, 
1 mode,dwell,,delay,,,istat) 


if(.not. istat)go to 550 


aaoana 


C 
¢ 
¢ 
10 
10 
15 
10 
20 
10 
30 
10 
56 
10 


Wait for a buffer to be processed 


c 

c 

c 

c 

$0 bufnum = lLpa$Siwtbuf(ibuf) 
if(bufnum .lt. 0)go to 100 

Cc 

c 

C 

c 


*e** process data here *** 


Go compute bound for some time determined by COMPUT paramater 
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do 60 ij=1,comput 
Go 60 1765 ame 
60 continue 
C 
c 
c Release buffer to be used again 
call Lpa$rlsbuf(ibuf,istat,bufnum) 
if(.not. istat)go to 540 
go to 50 
Check for successful completion or error 


00 if(.not. fosb(1))go to 560 
go to 10 


—noan 


c 
c 
c 
c Various error returns 
c 
500 call exit 
c 
510 write(output,2000)istat 
2000 format(' error loading microcode ',i6) 
999 nmode=-1234 
goto 10 
c 
c 
520 write(output,2010)istat 
2010 format(' error starting real time clock ',i6) 


goto 999 


0 write(output,2020)istat 
20 format(' error during ‘'setibf'’ call ‘',i6) 
goto 999 


c 
5 
2 
C 
540 write(output,2030)istat 
2030 format(' error from ‘‘risbuf'’ ',i6) 
goto 999 

c 

5 

2 

C 

5 


50 write(output ,2040) device, istat 
040 format(' error starting 
goto 999 


60 itemp=iand(iosb(3),'ff00'x)/256 
write(out ut,2050) fosb(1), itemp 

2050 reraet) PA error - VMS status ',i6,'(D), LPA status ',03,'(0)") 
goto 


-la2.* sweep ‘',i6) 


end 


c 
¢ Subroutine IBF INTCIBUF,ISTAT,BUFFER,BUFSIZ,NUMBER) 
Cc 


aaaonaaanna 


ao fo 


on 
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IBUF = impure data array for sweeps 

ISTAT = return status 

BUFFER = data buffer array 

BUFSIZ = size of each data buffer 

NUMBER = number of buffer areas to initialize 


IBFINT takes a buffer area, a buffer size and divides it into 
the specified number of individual data buffers. 


subroutine ibfint(ibuf,istat, buffer, bufsiz,number) 
integer*4 bufsiz,number 

integer*2 buf fer (bufsiz,0:number-1) 

go to (4,4,6,8,10,14,16,18) number 


call Lpa$Ssetibf(ibuf,istat, .buffer(1,0) ,buffer(1,1)) 
return 


call Lpa$Ssetibf(ibuf,istat, .buffer(1,0) ,.buffer(1,1), 
1 buffer (1,2)) 
return 


call Lpa$setibf(ibuf,is 
1 buffer(1,2), buffer(1, 
return 


call lpa$setibf(ibuf,istat,.b 
1 buffer(1,2) ,buffer(1,3), buf 
return 


call Lpa$Ssetibf(ibuf,istat, ,.buffer(1,0) .buffer(1,1), 
1 buffer(1.2) buffer(1,3), uffer(1,4),buffer(1,5)) 
return 


SOE eA TOPST ae UE TOP ES VD 


uffer(1,0),buffer(1,1), 
fer(1,4)) 


call lLpa$s fi 
1 buffer( buf 
2 buffer(1 


return 


eti 
2) 
6) 
call Lpa$seti 
1 buffer(1,2) 
2 buffer(1,6) 
return 

end 


———— eee 
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